VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.ocx"
Begin VB.Form MainForm 
   Caption         =   "Channel Importer for KG-UV950P"
   ClientHeight    =   2280
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6840
   Icon            =   "MainForm.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2280
   ScaleWidth      =   6840
   StartUpPosition =   2  'CenterScreen
   Begin VB.CheckBox Check1 
      Caption         =   "Remove existing channelinfo"
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   1680
      Width           =   2055
   End
   Begin VB.CommandButton Command3 
      Caption         =   "GO!"
      Height          =   495
      Left            =   4080
      TabIndex        =   4
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Select channel file"
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   840
      Width           =   2175
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Select KG-UVP950P file"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   2175
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   120
      Top             =   240
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label3 
      Caption         =   "PE1MHG"
      Height          =   255
      Left            =   6120
      TabIndex        =   6
      Top             =   2040
      Width           =   735
   End
   Begin VB.Label Label2 
      Height          =   495
      Left            =   2400
      TabIndex        =   3
      Top             =   960
      Width           =   4335
   End
   Begin VB.Label Label1 
      Height          =   375
      Left            =   2400
      TabIndex        =   1
      Top             =   360
      Width           =   4335
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim sKG, sChannel As String
Private Sub Command1_Click()
'get the kg settings file
CommonDialog1.Filter = "KG-UV950P (*.kg)|*.kg|All files (*.*)|*.*"
CommonDialog1.DefaultExt = "kg"
CommonDialog1.DialogTitle = "Select File to import channels into"
CommonDialog1.ShowOpen
sKG = CommonDialog1.FileName
Label1.Caption = sKG
'enable GO button if channel file has been set as well
If sChannel <> "" Then
  Command3.Enabled = True
End If
End Sub

Private Sub Command2_Click()
'get the channels file
CommonDialog1.Filter = "Channels (*.csv)|*.csv|All files (*.*)|*.*"
CommonDialog1.DefaultExt = "csv"
CommonDialog1.DialogTitle = "Select channel File to import channels into"
CommonDialog1.ShowOpen
sChannel = CommonDialog1.FileName
Label2.Caption = sChannel
'enable GO button if KG file has been set as well
If sKG <> "" Then
  Command3.Enabled = True
End If
End Sub

Private Sub Command3_Click()
import
End Sub
Private Sub import()
Dim fKG As Integer
Dim fChannel As Integer
Dim x As Integer
Dim y As Integer
Dim iChanNum As Integer
Dim sRecInfo As String
Dim sRecName As String
Dim sFileID As String
Dim sLine As String
Dim sTemp As String
Dim lChanInfo As Long
Dim lChanName As Long
Dim aLine() As String
Dim TR As String
'open both input files
fKG = FreeFile
Open sKG For Binary Access Read Write Lock Read Write As fKG
fChannel = FreeFile
Open sChannel For Input As fChannel
'read first 12  bytes to check if the version is correct
sRecInfo = Space(12)
Get fKG, 1, sRecInfo
sFileID = "R2_20130228" + Chr(0)
If sRecInfo = sFileID Then
  'set binary start locations of channel info and names
  lChanInfo = &HA0C
  lChanName = &H490C
  'this string is needed for converting ascii to the charset used by wouxun
  TR = "0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~? !" + Chr(34) + "#$%&'()*+,-./"
  'wipe old channelinfo and names if wanted by user
  If Check1.Value = 1 Then
    sRecInfo = String(16, Chr(255))
    sRecName = String(8, Chr(255))
    For x = 1 To 999
      Put fKG, lChanInfo + 1 + (x - 1) * 16, sRecInfo
      Put fKG, lChanName + 1 + (x - 1) * 8, sRecName
    Next
  End If
  'read the channel file
  While Not EOF(fChannel)
    Line Input #fChannel, sLine
    aLine = Split(sLine, Chr(9))
    'first field is channelnumber
    iChanNum = Val(aLine(0))
    If (iChanNum > 0) And (iChanNum < 1000) Then
      'pre-fill channelinfo with zeroes
      sRecInfo = String(16, Chr(0))
      'second field channelname
      sRecName = aLine(1)
      If sRecName <> "" Then
        sRecName = Left(sRecName + Space(8), 8)
        'translate in wouxun charset
        For x = 1 To Len(sRecName)
          Mid(sRecName, x, 1) = Chr(Val(InStr(TR, Mid(sRecName, x, 1)) - 1))
        Next
        'set the bit to signal presence of channelname
        sRecInfo = SetBit(sRecInfo, 14, &H80)
      End If
      'rx frequency (third field)
      'frequencies are stored as f.i.28.5mhz 02 85 00 00
      sTemp = ConvQRL(aLine(2))
      For x = 1 To 4
        Mid(sRecInfo, x, 1) = Mid(sTemp, x, 1)
      Next
      'tx frequency (fourth field)
      sTemp = ConvQRL(aLine(3))
      For x = 1 To 4
        Mid(sRecInfo, x + 4, 1) = Mid(sTemp, x, 1)
      Next
      'ctcss frequencies are stored as hex values f.i. 77.5 => 775 => 03 07
      'tx ctcss (6th field)
      sTemp = Replace(aLine(5), ",", ".")
      x = Val(sTemp)
      If x > 0 Then
        x = x * 10
        Mid(sRecInfo, 9, 1) = Chr(x \ 256)
        Mid(sRecInfo, 10, 1) = Chr(x Mod 256)
      End If
      'rx ctcss (5th field)
      sTemp = Replace(aLine(4), ",", ".")
      x = Val(sTemp)
      If x > 0 Then
        x = x * 10
        Mid(sRecInfo, 11, 1) = Chr(x \ 256)
        Mid(sRecInfo, 12, 1) = Chr(x Mod 256)
      End If
      'mute mode(12th field)
      Mid(sRecInfo, 13, 1) = Chr(&HEF)
      If InStr(aLine(11), "*") > 0 Then
        Mid(sRecInfo, 13, 1) = Chr(&HF7)
      End If
      If InStr(aLine(11), "+") > 0 Then
        Mid(sRecInfo, 13, 1) = Chr(&HFF)
      End If
      'scan (8th field) bit 6
      If Left(UCase(aLine(7)), 2) = "ON" Then
          sRecInfo = SetBit(sRecInfo, 14, &H40)
      End If
      'narrow/wide (9th field) bit 0
      If Left(UCase(aLine(8)), 1) = "N" Then
          sRecInfo = SetBit(sRecInfo, 14, &H1)
      End If
      'AM (13th field) bit 2
      If Left(UCase(aLine(12)), 2) = "ON" Then
          sRecInfo = SetBit(sRecInfo, 14, &H4)
      End If
      'Mandatory bit 1
      sRecInfo = SetBit(sRecInfo, 14, &H2)
      'tx power (7th field) bits 3 and 4
      sTemp = Left(UCase(aLine(6)), 1)
      Select Case sTemp
        Case "H"
          sRecInfo = SetBit(sRecInfo, 14, &H18)
        Case "M"
          sRecInfo = SetBit(sRecInfo, 14, &H10)
      End Select
      'scrambler (14th field) right nibble
      x = Val(aLine(13))
      If (x > 0) And (x < 9) Then
        sRecInfo = SetBit(sRecInfo, 16, x)
      End If
      'compander (15th field) left nibble
      sRecInfo = SetBit(sRecInfo, 16, &HE0)
      If Left(UCase(aLine(14)), 2) = "ON" Then
          sRecInfo = SetBit(sRecInfo, 16, &HF0)
      End If
      'write to file
      Put fKG, lChanInfo + 1 + (iChanNum - 1) * 16, sRecInfo
      Put fKG, lChanName + 1 + (iChanNum - 1) * 8, sRecName
    End If
  Wend
  MsgBox "Done!"
Else
  sFileID = ConvUnprint(sFileID)
  sRecInfo = ConvUnprint(sRecInfo)
  sTemp = "Awfully sorry OM. " + vbCrLf + "Not a supported KG file" + vbCrLf + "Supported is : " + sFileID + vbCrLf + "Your file has : " + sRecInfo
  MsgBox sTemp, vbCritical
End If
Close
End Sub
Private Function ConvUnprint(sInp As String) As String
Dim sTemp As String
Dim x As Integer
Dim y As Integer
'convert unprintable chars to decimal values
For x = 1 To Len(sInp)
  y = Asc(Mid(sInp, x, 1))
  If (y < 32) Or (y > 127) Then
    sTemp = sTemp + "[" + Trim(Str(y)) + "]"
  Else
    sTemp = sTemp + Mid(sInp, x, 1)
  End If
Next
ConvUnprint = sTemp
End Function

Private Function ConvQRL(sIn As String) As String
Dim sK As String
Dim sM As String
Dim sQRL As String
Dim sOUT As String
Dim x As Integer
'convert frequencyo hex values f.i. 28.5 mhz is stored as 02 85 00 00
sIn = Replace(sIn, ",", ".")
x = InStr(sIn, ".")
If x > 0 Then
  sK = Mid(sIn, x + 1)
  sM = Left(sIn, x - 1)
Else
  sM = sIn
End If
sQRL = Right(String(3, "0") + sM, 3) + Left(sK + String(5, "0"), 5)
sOUT = ""
For x = 1 To 7 Step 2
  sOUT = sOUT + Chr(Val("&H" + Mid(sQRL, x, 2)))
Next
ConvQRL = sOUT
End Function
Private Function SetBit(sIn As String, iPos As Integer, iMask As Integer) As String
Dim iCurVal As Integer
Dim iNewVal As Integer
'set mask in byte
iCurVal = Asc(Mid(sIn, iPos, 1))
iNewVal = iCurVal Or iMask
Mid(sIn, iPos, 1) = Chr(iNewVal)
SetBit = sIn
End Function
Private Sub Form_Load()
Command3.Enabled = False
Me.Caption = Me.Caption + "  (V" + Trim(Str(App.Major)) + "." + Trim(Str(App.Minor)) + "." + Trim(Str(App.Revision)) + ")"
End Sub
